home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / asmutil / disasm.zip / MUSIC.BAS < prev    next >
BASIC Source File  |  1988-06-03  |  17KB  |  219 lines
  1. 10 REM DSNAME = MUSIC.BAS
  2. 20 REM This version completed on 6/20/82.  For comments and suggestions,
  3. 30 REM please contact Bruce Guthrie by mail at
  4. 40 REM   P.O. Box 710
  5. 50 REM   Washington, D.C. 20044
  6. 60 REM Copyright 1982 by Bruce Guthrie
  7. 70 DEF FNCT(I)=BEAT+1/L*(1+.5*ABS(DOTTED=1))
  8. 80 DIM WHOLE%(19),HALF%(19),QUARTER%(19),EIGHTH%(37),SIXTEENTH%(37)
  9. 90 DIM WREST%(4),QREST%(25),EREST%(19),SREST%(21)
  10. 100 DIM CURSOR%(19),DOT%(37),FORBID%(25),NULL%(19),TIED%(10)
  11. 110 DIM FLAT%(15),NATURAL%(16),SHARP%(15)
  12. 120 DIM TREBLE%(73),BASE%(39)
  13. 130 DIM ONE%(39),TWO%(39),THREE%(39),FOUR%(39),EIGHT%(39)
  14. 140 DIM P$(1000),P(1000),KEYS(7)
  15. 150 SCREEN 1:KEY OFF:FOR I=1 TO 10:KEY I,"":NEXT I
  16. 160 BEAT=0:CUREND=0:TIE=0:DOTTED=0:SHARP=0:FLAT=0:NATURAL=0:NOTE=2:REPEAT=-1:POINTER=0
  17. 170 CLS:PRINT TAB(10);"Music package":PRINT TAB(3);"(c) Bruce Guthrie June, 1982"
  18. 180 INPUT "Need instructions [Y/N]? ",A$:IF A$="n" OR A$="N" THEN 220:ELSE IF A$<>"y" AND A$<>"Y" THEN 180
  19. 190 OPEN "music.ins" FOR INPUT AS #1:I=0
  20. 200 I=I+1:IF EOF(1) THEN 220
  21. 210 INPUT #1,A$:PRINT A$:IF I<22 THEN 200:ELSE I=0:INPUT "Press RETURN? ",A$:GOTO 200
  22. 220 GOSUB 1350  'read in PUT definitions for notes
  23. 230 PLAY "MB":CLS:INPUT "Is composition saved already [Y/N]? ",A$:IF A$<>"Y" AND A$<>"y" AND A$<>"N" AND A$<>"n" THEN 230:ELSE IF A$="Y" OR A$="y" THEN GOTO 1190:ELSE CLS:P$(0)="T120":P(0)=-1
  24. 240 GOSUB 2020:NOTE=12 'draw clefs
  25. 250 GOSUB 890        'set key
  26. 260 GOSUB 830        'set bar measure
  27. 270 GOSUB 300        'enter notes
  28. 280 NEWPAGE=0:GOSUB 2050:IF NEWPAGE=1 THEN GOTO 270:ELSE GOSUB 320:GOTO 280
  29. 290 'INPUT NOTE****************************************************************
  30. 300 GOSUB 1910:PRINT"Enter note: sharp(+),flat(-),nat(N),":PRINT "rest(P), 1,2,4,8,S(16th)":PRINT"change key(K),measure(M),tempo(T)"
  31. 310 LOCATE 20,1:PRINT "'1 play, '3 save, '2 tie notes":PRINT ". (dotted note)":' print "[ (begin) and ] (end) repeat"
  32. 320 LOCATE 4,1:PRINT "Use cursor controls to position note. ":GOSUB 1890:PAUSE=0
  33. 330 X$=INKEY$:IF X$="" THEN 330:ELSE IF LEN(X$)=1 THEN 390:ELSE X=ASC(MID$(X$,2))
  34. 340 IF X=59 THEN GOSUB 1890:BEAT=0:GOSUB 1920:GOSUB 1020:GOTO 300 'SF 1 (play song)
  35. 350 IF X=60 THEN GOSUB 1950:IF TIE=1 THEN TIE=0:GOSUB 1950:GOTO 330:ELSE TIE=1:GOSUB 1950:GOTO 330 'SF 2 (tie notes)
  36. 360 IF X=61 THEN GOSUB 1150:GOSUB 1940:NEWPAGE=1:GOTO 300 'SF 3 (save it)
  37. 370 IF X=72 THEN GOSUB 1890:GOSUB 1950:NOTE=NOTE-1:IF NOTE=0 THEN NOTE=25:GOSUB 1890:GOSUB 1950:GOTO 330:ELSE GOSUB 1890:GOSUB 1950:GOTO 330 'cursor up
  38. 380 IF X=80 THEN GOSUB 1890:GOSUB 1950:NOTE=NOTE+1:IF NOTE=26 THEN NOTE=1:GOSUB 1890:GOSUB 1950:GOTO 330:ELSE GOSUB 1890:GOSUB 1950:GOTO 330 'cursor down
  39. 390 A1$=X$:IF A1$="#" THEN A1$="+":ELSE IF A1$>="a" AND A1$<="z" THEN A1$=CHR$(ASC(A1$)-32)
  40. 400 ON INSTR("+-.1248KMNSPT[]",A1$)+1 GOTO 330,520,520,410,440,440,440,440,460,470,520,450,420,500,480,490
  41. 410 GOSUB 1950:IF DOTTED=1 THEN DOTTED=0:GOSUB 1950:GOTO 330:ELSE DOTTED=1:GOSUB 1950:GOTO 330  'dotted note
  42. 420 GOSUB 1920:PRINT "Enter length for this rest? ";:PAUSE=1
  43. 430 A1$=INKEY$:IF LEN(A1$)<>1 THEN 430:ELSE ON INSTR("1248Ss",A1$)+1 GOTO 430,440,440,440,440,450,450
  44. 440 L=VAL(A1$):A1$="0":GOTO 580
  45. 450 L=16:A1$="0":GOTO 580
  46. 460 C=0:GOSUB 1890:GOSUB 890:GOTO 300 'change key
  47. 470 C=0:GOSUB 1890:GOSUB 830:GOTO 300 'change bar measure
  48. 480 'BEGIN REPEAT
  49. 490 'END REPEAT
  50. 500 GOSUB 1920:INPUT "New tempo [32<=x<=255]? ",TEMPO:IF TEMPO<32 OR TEMPO>255 THEN 500
  51. 510 GOSUB 1890:GOSUB 1920:P1$="T"+MID$(STR$(TEMPO+1000),3):INPUT "Play all with this [Y/N]? ",A$:IF A$="Y" THEN P$(0)=P1$:GOTO 300:ELSE IF A$="N" THEN POINTER=CUREND:GOSUB 780:GOTO 300:ELSE GOTO 510
  52. 520 IF A1$="+" AND FORBID%(NOTE)=1 THEN BEEP:GOTO 330:ELSE IF A1$="-" AND FORBID%(NOTE)=2 THEN BEEP:GOTO 330    'checking on flats and sharps
  53. 530 GOSUB 1950:IF A1$="+" THEN IF SHARP=1 THEN SHARP=0:GOSUB 1950:GOTO 330:ELSE SHARP=1:FLAT=0:NATURAL=0:GOSUB 1950:GOTO 330  'sharp
  54. 540 IF A1$="-" THEN IF FLAT=1 THEN FLAT=0:GOSUB 1950:GOTO 330:ELSE FLAT=1:SHARP=0:NATURAL=0:GOSUB 1950:GOTO 330              'flat
  55. 550 IF FLAT=1 THEN NATURAL=0:GOSUB 1950:GOTO 330:ELSE NATURAL=1:FLAT=0:SHARP=0:GOSUB 1950:GOTO 330                           'natural
  56. 560 GOSUB 1920:INPUT "Enter length for this note/rest? ",L:IF L=0 THEN GOSUB 1890:GOTO 320
  57. 570 'DRAW NOTE*****************************************************************
  58. 580 GOSUB 1890:IF FNCT(I)>TOP/BOTTOM THEN GOSUB 1920:PRINT "Note of this length doesn't fit in bar":BEEP:GOSUB 1930:GOTO 320:ELSE GOSUB 590:GOTO 720
  59. 590 IF PAUSE=0 THEN ON L GOTO 660,670,590,680,590,590,590,690,590,590,590,590,590,590,590,700
  60. 600 ON L GOTO 610,620,600,630,600,600,600,640,600,600,600,600,600,600,600,650   'REST NOTES
  61. 610 PUT(WHERE-4,61),WREST%,OR:RETURN
  62. 620 PUT(WHERE-4,67),WREST%,OR:RETURN
  63. 630 PUT(WHERE-4,60),QREST%,OR:RETURN
  64. 640 PUT(WHERE-4,60),EREST%,OR:RETURN
  65. 650 PUT(WHERE-4,60),SREST%,OR:RETURN
  66. 660 PUT (WHERE-4,NOTE*5+38),NULL%,PSET:PUT (WHERE-4,NOTE*5+38),NULL%,XOR:PUT(WHERE-4,NOTE*5+25),WHOLE%,OR:RETURN
  67. 670 PUT (WHERE-4,NOTE*5+38),NULL%,PSET:PUT (WHERE-4,NOTE*5+38),NULL%,XOR:PUT(WHERE-4,NOTE*5+25),HALF%,OR:RETURN
  68. 680 PUT (WHERE-4,NOTE*5+25),QUARTER%,OR:RETURN
  69. 690 PUT (WHERE-4,NOTE*5+25),EIGHTH%,OR:RETURN
  70. 700 PUT (WHERE-4,NOTE*5+25),SIXTEENTH%,OR:RETURN
  71. 710 'FIGURE OUT WHAT TO PLAY***************************************************
  72. 720 IF PAUSE=1 THEN P1$="O3P ":GOTO 740:ELSE P2$=MID$("GFEDCBAGFEDCBAGFEDCBAGFEDCBA",NOTE,1):P1$=P2$:IF NOTE<6 THEN P1$="O4"+P1$:ELSE IF NOTE<13 THEN P1$="O3"+P1$:ELSE IF NOTE<20 THEN P1$="O2"+P1$:ELSE P1$="O1"+P1$
  73. 730 IF FLAT=1 THEN P1$=P1$+"-":ELSE IF SHARP=1 THEN P1$=P1$+"+":ELSE IF NATURAL=1 THEN P1$=P1$+" ":ELSE P1$=P1$+MID$("- +",KEYS(ASC(P2$)-64)+2,1)
  74. 740 IF TIE=1 THEN P1$="ML"+P1$:ELSE P1$="MN"+P1$
  75. 750 P1$=P1$+MID$(STR$(100+L),3):IF DOTTED=1 THEN P1$=P1$+".":ELSE P1$=P1$+" "
  76. 760 ON ERROR GOTO 820:PLAY P1$:ON ERROR GOTO 0
  77. 770 'INSERT NOTE AFTER POINTER*************************************************
  78. 780 N1=P(POINTER):CUREND=CUREND+1:P(POINTER)=CUREND:POINTER=P(POINTER):P$(POINTER)=P1$:P(POINTER)=N1:RETURN
  79. 790 'DELETE NOTE AFTER POINTER*************************************************
  80. 800 P$(P(POINTER))="":P(POINTER)=P(P(POINTER)):RETURN
  81. 810 'ERROR*********************************************************************
  82. 820 GOSUB 1920:PRINT "Sorry.  That note's incorrect.":RESUME 300
  83. 830 'SET TEMPO****************************************************************
  84. 840 GOSUB 1910:INPUT "Bar measure, e.g. 4/4? ",A$
  85. 850 X=INSTR(A$,"/"):IF X=0 THEN PRINT "No division symbol [/].  Re-enter.":GOTO 840:ELSE IF X=1 OR LEN(A$)=X THEN 840
  86. 860 TOP=VAL(MID$(A$,1,X-1)):BOTTOM=VAL(MID$(A$,X+1)):IF MID$("XXXX   X",BOTTOM,1)+MID$("XXXX   X",TOP,1)<>"XX" THEN PRINT "Illegal numbers.  Re-enter.":GOTO 830
  87. 870 P1$="B"+RIGHT$(STR$(TOP),2)+"/"+RIGHT$(STR$(BOTTOM),2):POINTER=CUREND:GOSUB 780:GOTO 2120
  88. 880 'SET KEY******************************************************************
  89. 890 GOSUB 1910:PRINT "Use cursor controls [up/down] and +/-":PRINT "keys to position/set flats and sharps.":PRINT "Use CR to stop.  Do top clef only."
  90. 900 FOR I=1 TO 7:KEYS(I)=0:NEXT I:NOTE=2
  91. 910 GOSUB 1900
  92. 920 X$=INKEY$:IF X$="" THEN 920
  93. 930 IF X$="+" OR X$="#" THEN IF FORBID%(NOTE)=1 THEN BEEP:GOTO 920:ELSE I=1:GOSUB 1000:PUT(WHERE+4,NOTE*5+32),SHARP%,XOR:GOTO 920
  94. 940 IF X$="-" THEN IF FORBID%(NOTE)=2 THEN BEEP:GOTO 920:ELSE I=-1:GOSUB 1000:PUT(WHERE+4,NOTE*5+32),FLAT%,XOR:GOTO 920
  95. 950 IF ASC(X$)=13 THEN P1$="K":FOR I=0 TO 7:P1$=P1$+STR$(KEYS(I)):NEXT I:POINTER=CUREND:GOSUB 780:GOSUB 1900:GOSUB 2080:WHERE=WHERE+4:NOTE=12:RETURN  'carriage return
  96. 960 IF LEN(X$)<2 THEN 920:ELSE X=ASC(MID$(X$,2))
  97. 970 IF X=72 THEN GOSUB 1900:NOTE=NOTE-1:IF NOTE=0 THEN NOTE=7:GOSUB 1900:ELSE GOSUB 1900
  98. 980 IF X=80 THEN GOSUB 1900:NOTE=NOTE+1:IF NOTE=8 THEN NOTE=1:GOSUB 1900:ELSE GOSUB 1900
  99. 990 GOTO 920
  100. 1000 IF KEYS(8-NOTE)=I THEN KEYS(0)=KEYS(0)-1:KEYS(8-NOTE)=0:RETURN:ELSE IF KEYS(8-NOTE)=-I THEN KEYS(8-NOTE)=I:RETURN:ELSE KEYS(8-NOTE)=I:KEYS(0)=KEYS(0)+1:RETURN
  101. 1010 'PLAY IT WHILE DRAWING IT*************************************************
  102. 1020 GOSUB 2020:E=0:WHILE E>-1:A$=P$(E):A1$=MID$(A$,1,1)
  103. 1030 IF A1$="T" THEN PLAY A$:GOTO